VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsUser"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
'-----------------------------------------------------------------
'             PT DC Hub @ Direct Connect P2P Network
'-----------------------------------------------------------------
'       Developer: Carlos.DF (fLaSh) - Portugal
'          E-mail: carlosferreiracarlos@hotmail.com
' Project started: 10 - September - 2006
'         License: GNU General Public License.
'-----------------------------------------------------------------
'       Thanks to developers and contributores of SDCH/DDCH
'         The Left Hand, ButterflySoul, HaArD and Selyb
'  TheNOP, RollTheDice, JDommi, GhOstFaCE, ArchaicLight and TUFF
'-----------------------------------------------------------------
Option Explicit

Public DataFragment                 As String

Private Type typTAG
    sAll            As String
    sClient         As String
    sVersion        As String
    iHubsUnReg      As Integer
    iHubsReg        As Integer
    iHubsOp         As Integer
    iSlots          As Integer
    sDescription    As String
    sConnection     As String
    sEmail          As String
End Type

Private m_oTAG                      As typTAG

Private m_strName                   As String
Private m_strIP                     As String
Private m_strMyINFO                 As String
Private m_strFakeMyINFO             As String
Private m_strLanguageID             As String
Private m_strSupports               As String

Private m_datConnectedSince         As Date

Private m_dblBytesShared            As Double
Private m_dblVersion                As Double

Private m_intIndex                  As Integer

Private m_blnQNL                    As Boolean
Private m_blnQuickList              As Boolean
Private m_blnOperator               As Boolean
Private m_blnVisible                As Boolean
Private m_blnAFK                    As Boolean
Private m_blnMute                   As Boolean
Private m_blnPassive                As Boolean
Private m_blnUserCommand            As Boolean
Private m_blnNoHello                As Boolean
Private m_blnNetInfo                As Boolean
Private m_blnZLine                  As Boolean
Private m_blnZPipe                  As Boolean

Private m_intClass                  As enuClass
Private m_intState                  As enuState
Private m_wskUser                   As Winsock

#If FLASHCHAT Then
    Private m_blnNullCharSeparator  As Boolean
#End If

Private m_blnChatOnly               As Boolean

Private m_bytMICount            As Byte
Private m_bytNLCount            As Byte
Private m_bytPSCount            As Byte
Private m_bytASCount            As Byte
Private m_lngMITick             As Long
Private m_lngNLTick             As Long
Private m_lngPSTick             As Long
Private m_lngASTick             As Long

Private m_bytCCount            As Byte
Private m_lngCTick             As Long
'svn 216
Private m_lngDropTick          As Long

Private m_bytGCount            As Byte
Private m_lngGTick             As Long
Private m_dtLastSearch         As Date

Private Sub Class_Initialize()
1:    m_datConnectedSince = Now
End Sub

Public Property Let sName(ByRef strName As String)
1:    m_strName = strName
End Property

Public Property Get sName() As String
1:    sName = m_strName
End Property

Public Property Get IP() As String
1:    IP = m_strIP
End Property

Public Property Get MyINFO(Optional ByVal iType As enTAG = eTag) As Variant
    On Error GoTo Err
    Select Case iType
        Case eTag:          MyINFO = m_oTAG.sAll
        Case eClient:       MyINFO = m_oTAG.sClient
        Case eVersion:      MyINFO = m_oTAG.sVersion
        Case eHubsUnReg:    MyINFO = m_oTAG.iHubsUnReg
        Case eHubsReg:      MyINFO = m_oTAG.iHubsReg
        Case eHubsOp:       MyINFO = m_oTAG.iHubsOp
        Case eHubsCount:    MyINFO = (m_oTAG.iHubsUnReg + m_oTAG.iHubsReg + m_oTAG.iHubsOp)
        Case eSlots:        MyINFO = m_oTAG.iSlots
        Case eDescription:  MyINFO = m_oTAG.sDescription
        Case eConnection:   MyINFO = m_oTAG.sConnection
        Case eEmail:        MyINFO = m_oTAG.sEmail
    End Select
    Exit Property
Err:
    HandleError Err.Number, Err.Description, Erl & "|" & "clsUser.GetMyINFO(" & CStr(iType) & ")"
End Property

Public Property Let sMyInfoString(ByVal strData As String)
1:     On Error GoTo Err
2:     Dim arrSplit()  As String
3:     Dim arrTemp()   As String
4:     Dim sTemp       As String
5:     Dim intPos As Integer
6:     Dim dblShare    As Double
    
8:     m_strMyINFO = strData
 
10:    If g_objSettings.HideMyinfos Then
11:        m_strFakeMyINFO = "$MyINFO $ALL " & g_objRegExps.CaptureSubStr(strData, GETNICK) & " $ $" & g_objRegExps.CaptureSubStr(strData, GETCONTYPE) & g_objRegExps.CaptureSubStr(strData, GETSTATUS) & "$$" & g_objRegExps.CaptureDbl(strData, GETSHARESIZE) & "$"
12:    End If

       'Is just, everything if is processed already.. Is need for exemple to set user shared and hub shared total
14:    If LenB(m_strName) = 0 Or m_intClass < Normal Then Exit Property
       'NOTE:
       '    Some properties will be better more
       '    updated in frmHub.ProcessMyINFO function..
       '    for eg: the shared
       '-------------------------------------------------
21:    On Error Resume Next
       'It is parsed upto the $ALL part of the string
       'Format : $ALL <name> <description>$ $<connection><chr_flag>$<email>$<share>$
24:    arrSplit = Split(Mid$(strData, 14), "$") 'Split and extract '$MyINFO $ALL '
       'fLaSh PT DC Hub Author<++ V:0.674,M:A,H:0/1/12,S:4>$ $DSL$carlosferreiracarlos@hotmail.com$14585001933$
       'arrSplit(0) = 'fLaSh PT DC Hub Author (www.ptdch.com)<++ V:0.674,M:A,H:1/1/12,S:4>'
       'arrSplit(1) = ' '
       'arrSplit(2) = 'DSL'
       'arrSplit(3) = 'carlosferreiracarlos@hotmail.com'
       'arrSplit(4) = '14585001933'
       'arrSplit(5) = ''

       'Extract All Tag and Desciption
34:    If InStr(1, arrSplit(0), "<") Then
           'Extract TAG, eg: <++ V:0.674,M:A,H:0/1/12,S:4>
36:        intPos = g_objFunctions.LastPosition(arrSplit(0), "<")
37:        m_oTAG.sAll = Mid$(arrSplit(0), intPos)
           'Extract description, eg: PT DC Hub Author (www.ptdch.com)
39:        sTemp = g_objFunctions.AfterFirst(arrSplit(0), " ")
40:        sTemp = Replace(sTemp, m_oTAG.sAll, "")  'Remevo tag
41:        m_oTAG.sDescription = sTemp
44:    End If

      'Extract Hubs count
47:    If InStr(1, m_oTAG.sAll, "H:") And InStr(1, m_oTAG.sAll, ",S:") Then
48:        sTemp = g_objFunctions.BetweenFirst(m_oTAG.sAll, "H:", ",S:")
49:        arrTemp = Split(sTemp, "/")
50:        If UBound(arrTemp) = 2 Then
51:            If IsNumeric(arrTemp(0)) And IsNumeric(arrTemp(0)) And IsNumeric(arrTemp(0)) Then
52:                m_oTAG.iHubsUnReg = CInt(arrTemp(0))
53:                m_oTAG.iHubsReg = CInt(arrTemp(1))
54:                m_oTAG.iHubsOp = CInt(arrTemp(2))
55:            End If
56:        End If
57:    End If
    
       'Extract Slots count
60:    If InStr(1, m_oTAG.sAll, ",S:") Then
61:        sTemp = g_objFunctions.AfterFirst(m_oTAG.sAll, "S:")
62:        Do
63:            If LenB(sTemp) < 1 Then Exit Do
64:            sTemp = LeftB$(sTemp, LenB(sTemp) - 1)
65:        Loop While (Not IsNumeric(sTemp))
66:        If IsNumeric(sTemp) Then
67:            m_oTAG.iSlots = sTemp
68:        End If
69:    End If
    
       'Extract Client type and version
72:    If InStr(m_oTAG.sAll, "V:") Then
73:        sTemp = g_objFunctions.BetweenFirst(m_oTAG.sAll, "<", " V:")
74:        If LenB(sTemp) Then
75:            m_oTAG.sClient = sTemp
76:        End If
77:        sTemp = g_objFunctions.BetweenFirst(m_oTAG.sAll, "V:", ",M:")
78:        If LenB(sTemp) Then
79:            m_oTAG.sVersion = sTemp
80:        End If
81:    End If
    
       'Extract Connetction
84:    If UBound(arrSplit) > 1 Then
85:        If LenB(arrSplit(2)) > 2 Then
86:            m_oTAG.sConnection = LeftB$(arrSplit(2), LenB(arrSplit(2)) - 2)
87:        End If
88:    End If
    
       'Extract Email
91:    If UBound(arrSplit) > 2 Then
92:        If LenB(arrSplit(3)) Then
93:            m_oTAG.sEmail = arrSplit(3)
94:        End If
95:    End If
 
97:    If UBound(arrSplit) > 3 Then
98:        dblShare = CDbl(arrSplit(4))
99:        If dblShare Then
100:            If Not m_blnChatOnly Then
                  'Don't add invisible user's share
102:               If m_blnVisible Then
103:                   g_colUsers.iTotalBytesShared = g_colUsers.iTotalBytesShared - m_dblBytesShared + dblShare
104:                   m_dblBytesShared = dblShare
105:               End If
106:            End If
107:        End If
108:    End If
 
110:    Exit Property
111:
Err:
112:    HandleError Err.Number, Err.Description, Erl & "|" & "clsUser.sMyInfoString(" & CStr(strData) & ")"
End Property
Public Property Get sMyInfoString() As String
1:    sMyInfoString = m_strMyINFO
End Property

Public Property Let sMyInfoFakeString(ByRef strData As String)
1:    m_strFakeMyINFO = strData
End Property
Public Property Get sMyInfoFakeString() As String
1:    sMyInfoFakeString = m_strFakeMyINFO
End Property

Public Property Let Supports(ByRef strData As String)
1:    m_strSupports = strData
End Property
Public Property Get Supports() As String
1:    Supports = m_strSupports
End Property

Public Property Get ConnectedSince() As Date
1:    ConnectedSince = m_datConnectedSince
End Property

Public Property Let iBytesShared(ByRef dblData As Double)
1:    m_dblBytesShared = dblData
End Property
Public Property Get iBytesShared() As Double
1:    iBytesShared = m_dblBytesShared
End Property

Public Property Let iVersion(ByRef dblData As Double)
1:    m_dblVersion = dblData
End Property
Public Property Get iVersion() As Double
1:    iVersion = m_dblVersion
End Property

Public Property Let iWinsockIndex(ByRef intData As Integer)
1:    m_intIndex = intData
End Property
Public Property Get iWinsockIndex() As Integer
1:    iWinsockIndex = m_intIndex
End Property

Public Property Let QNL(ByRef blnData As Boolean)
1:    m_blnQNL = blnData
End Property
Public Property Get QNL() As Boolean
1:    QNL = m_blnQNL
End Property

Public Property Let QuickList(ByRef blnData As Boolean)
1:    m_blnQuickList = blnData
End Property
Public Property Get QuickList() As Boolean
1:    QuickList = m_blnQuickList
End Property

Public Property Let NoHello(ByRef blnData As Boolean)
1:    m_blnNoHello = blnData
End Property
Public Property Get NoHello() As Boolean
1:    NoHello = m_blnNoHello
End Property

Public Property Let ZLine(ByRef blnData As Boolean)
1:    m_blnZLine = blnData
End Property
Public Property Get ZLine() As Boolean
1:    ZLine = m_blnZLine
End Property

Public Property Let ZPipe(ByRef blnData As Boolean)
1:    m_blnZPipe = blnData
End Property
Public Property Get ZPipe() As Boolean
1:    ZPipe = m_blnZPipe
End Property

Public Property Get bOperator() As Boolean
1:    bOperator = m_blnOperator
End Property
Public Property Get Visible() As Boolean
1:    Visible = m_blnVisible
End Property

Public Property Let IsAFK(ByRef blnData As Boolean)
1:    m_blnAFK = blnData
End Property
Public Property Get IsAFK() As Boolean
1:    IsAFK = m_blnAFK
End Property

Public Property Let Mute(ByRef blnData As Boolean)
1:    m_blnMute = blnData
End Property

Public Property Get Mute() As Boolean
1:    Mute = m_blnMute
End Property

Public Property Let Passive(ByRef blnData As Boolean)
1:    m_blnPassive = blnData
End Property
Public Property Get Passive() As Boolean
1:    Passive = m_blnPassive
End Property

Public Property Let UserCommand(ByRef blnData As Boolean)
1:    m_blnUserCommand = blnData
End Property
Public Property Get UserCommand() As Boolean
1:    UserCommand = m_blnUserCommand
End Property

#If FLASHCHAT Then
    Public Property Let NullCharSeparator(ByRef blnData As Boolean)
1:        m_blnNullCharSeparator = blnData
    End Property
    Public Property Get NullCharSeparator() As Boolean
1:        NullCharSeparator = m_blnNullCharSeparator
    End Property
#End If

Public Property Let ChatOnly(ByRef blnData As Boolean)
1:    m_blnChatOnly = blnData
End Property
Public Property Get ChatOnly() As Boolean
1:    ChatOnly = m_blnChatOnly
End Property
    
Public Property Let NetInfo(ByRef blnData As Boolean)
1:    m_blnNetInfo = blnData
End Property
Public Property Get NetInfo() As Boolean
1:    NetInfo = m_blnNetInfo
End Property

Public Property Let Class(ByRef intData As enuClass)
1:    m_intClass = intData
2:    m_blnOperator = (intData >= Op)
    
    'Set visible status
    Select Case intData
        Case Invisible, InvisibleOp, InvisibleSuperOp, InvisibleAdmin
5:            m_blnVisible = False
        Case Else
6:            m_blnVisible = True
7:            Me.sMyInfoString = m_strMyINFO 'UpDate the TAG
8:    End Select
End Property
Public Property Get Class() As enuClass
1:    Class = m_intClass
End Property

Public Property Let State(ByRef intData As enuState)
1:    m_intState = intData
End Property
Public Property Get State() As enuState
1:    State = m_intState
End Property

Public Property Set Winsock(ByRef wskData As Winsock)
1:    Set m_wskUser = wskData
2:    If ObjPtr(wskData) Then m_strIP = m_wskUser.RemoteHostIP
End Property
Public Property Get Winsock() As Winsock
1:    Set Winsock = m_wskUser
End Property

Public Property Let sLanguageID(ByRef strData As String)
1:    m_strLanguageID = strData
End Property
Public Property Get sLanguageID() As String
1:    sLanguageID = m_strLanguageID
End Property

Friend Function FloodGenericCheck() As Boolean
1:    Dim lngTick           As Long
2:    Const cFLOOD          As Integer = 3000 ' 3 secund
3:    Const cMaxAllowed     As Byte = 6 ' 3 attenps
4:    On Error GoTo Err
 
6:    If Me.Class < Op Then

8:         lngTick = GetTickCount

10:        If Abs((lngTick - m_lngGTick)) > cFLOOD Then
11:            m_bytGCount = 1
12:            m_lngGTick = lngTick
13:        Else
14:            m_bytGCount = m_bytGCount + 1
            
16:            If m_bytGCount > cMaxAllowed Then
17:                Kick g_objSettings.FWBanLength, "PTDCH / Core", "Flood Detected - Generic"
18:                FloodGenericCheck = True
                   'Show pupop notification ..
20:                If g_objSettings.PopUpFlood Then
21:                     g_objFunctions.ShowBallon _
                             "PT DC Hub v" & vbVersion & " - Flood Detected", _
                             "Type: Generic" & vbNewLine & _
                             "User: " & Me.sName, 1, True
25:                End If
26:                AddLog "Flood Detected: Generic - User: " & Me.sName
27:             End If
28:        End If
29:    End If
    
31:    Exit Function
32:
Err:
33:    HandleError Err.Number, Err.Description, Erl & "|" & "clsUser.FloodGenericCheck()"
End Function

Friend Function FloodCheck(ByRef bytID As Byte) As Boolean
1:    Dim lngTick As Long
2:    Dim IsBlockSearch As Boolean
3:    Dim strTemp As String
4:    On Error GoTo Err

6:    lngTick = GetTickCount
    
      Select Case bytID
      
          Case 0 'Active search
          
10:             strTemp = "Active search"
            
12:            If g_objSettings.EnableFloodWall And (Abs((lngTick - m_lngASTick)) > g_objSettings.FWInterval) Then
13:                 m_bytASCount = 1
14:                 m_lngASTick = lngTick
15:            Else
                    'This because that is called same that be desabled 'EnableFloodWall', to control the searchs
17:                If g_objSettings.EnableFloodWall Then m_bytASCount = m_bytASCount + 1

19:                If m_bytASCount > g_objSettings.FWActiveSearch Then
20:                    Kick g_objSettings.FWBanLength, "PTDCH / Core", "Flood Detected - " & strTemp
21:                    FloodCheck = True
22:                Else
                       'Check search interval (secunds)
24:                    If g_objSettings.MinSearchActive And Me.Class < Vip Then
25:                        If Not CBool(m_dtLastSearch = 0) Then 'Is not empty ?
26:                            If DateDiff("s", m_dtLastSearch, Now) < g_objSettings.MinSearchActive Then
27:                                SendChat g_objSettings.BotName, Replace(GetCoreMsgStr("SearchInterval"), "%[secunds]", g_objSettings.MinSearchActive)  'Do not repeat searches within %[secunds] seconds.
28:                                FloodCheck = True
29:                                IsBlockSearch = True
30:                            Else
31:                                m_dtLastSearch = Now
32:                            End If
33:                        Else
34:                            m_dtLastSearch = Now
35:                        End If
36:                     End If
37:                End If
38:           End If

        Case 1 'Passive search
        
41:            strTemp = "Passive search"

               'This because that is called same that be desabled 'EnableFloodWall', to control the searchs
44:            If g_objSettings.EnableFloodWall And (Abs((lngTick - m_lngPSTick)) > g_objSettings.FWInterval) Then
45:                m_bytPSCount = 1
46:                m_lngPSTick = lngTick
47:            Else
48:                If g_objSettings.EnableFloodWall Then m_bytPSCount = m_bytPSCount + 1
                
50:                If m_bytPSCount > g_objSettings.FWPassiveSearch Then
51:                    Kick g_objSettings.FWBanLength, "PTDCH / Core", "Flood Detected - " & strTemp
52:                    FloodCheck = True
53:                Else
                       'Check search interval (secunds)
55:                    If g_objSettings.MinSearchActive And Me.Class < Vip Then
56:                        If Not CBool(m_dtLastSearch = 0) Then 'Is not empty ?
57:                            If DateDiff("s", m_dtLastSearch, Now) < g_objSettings.MinSearchPassive Then
58:                                SendChat g_objSettings.BotName, Replace(GetCoreMsgStr("SearchInterval"), "%[secunds]", g_objSettings.MinSearchPassive)  'Do not repeat searches within %[secunds] seconds.
59:                                IsBlockSearch = True
60:                                FloodCheck = True
61:                            Else
62:                                m_dtLastSearch = Now
63:                            End If
64:                        Else
65:                            m_dtLastSearch = Now
66:                        End If
67:                     End If
68:                End If
69:            End If

        Case 2 'MyINFO
        
72:            strTemp = "MyINFO"
        
74:            If Abs((lngTick - m_lngMITick)) > g_objSettings.FWInterval Then
75:                m_bytMICount = 1
76:                m_lngMITick = lngTick
77:            Else
78:                m_bytMICount = m_bytMICount + 1
                
80:                If m_bytMICount > g_objSettings.FWMyINFO Then
81:                    Kick g_objSettings.FWBanLength, "PTDCH / Core", "Flood Detected - " & strTemp
82:                    FloodCheck = True
83:                End If
84:            End If

        Case 3 'GetNickList
        
87:            strTemp = "GetNickList"
        
89:            If Abs((lngTick - m_lngNLTick)) > g_objSettings.FWInterval Then
90:                m_bytNLCount = 1
91:                m_lngNLTick = lngTick
92:            Else
93:                m_bytNLCount = m_bytNLCount + 1
                
95:                If m_bytNLCount > g_objSettings.FWGetNickList Then
96:                    Kick g_objSettings.FWBanLength, "PTDCH / Core", "Flood Detected - " & strTemp
97:                    FloodCheck = True
98:                End If
99:            End If

        Case 4 'Main Chat, PM
        
102:             strTemp = "Chat Message"
        
104:            If Abs((lngTick - m_lngCTick)) > g_objSettings.FWInterval Then
105:                m_bytCCount = 1
106:                m_lngCTick = lngTick
107:            Else
108:                m_bytCCount = m_bytCCount + 1
                
                   'svn 216
111:                If Abs((lngTick - m_lngDropTick)) > g_objSettings.FWDropMsgInterval Then
112:                    m_lngDropTick = lngTick
113:                Else
114:                    SendChatLng g_objSettings.BotName, "FWDropMsg" ' "your message was not sent, please send your messages a bit slower."
115:                    FloodCheck = True
116:                End If
                
                   'g_objSettings.FWMainChat is setable only in xml and script...
119:                If m_bytCCount > g_objSettings.FWMainChat Then
120:                    Kick g_objSettings.FWBanLength, "PTDCH / Core", "Flood Detected - " & strTemp
121:                    FloodCheck = True
122:                End If
123:            End If

125:    End Select

127:    If FloodCheck And Not IsBlockSearch Then
           'Show pupop notification ..
129:        If g_objSettings.PopUpFlood Then
130:            g_objFunctions.ShowBallon _
                    "PT DC Hub v" & vbVersion & " - Flood Detected", _
                    "Type: " & strTemp & vbNewLine & _
                    "User: " & Me.sName, 1, True
134:        End If
135:        AddLog "Flood Detected: " & strTemp & " - User: " & Me.sName
136:    End If
        
138:    Exit Function
139:
Err:
140:    HandleError Err.Number, Err.Description, Erl & "|" & "clsUser.FloodCheck(" & bytID & ")"
End Function
'Send any message to user (don't forget the |)
Public Sub SendData(ByRef strData As String)
1:    Dim objZLib         As clsZLib
2:    On Error GoTo Err

  #If SVN Then
5:    On Error Resume Next
6:    If LenB(strData) Then
7:         frmHub.SNVAddLog "TO: " & g_colUsers.ItemByIP(m_wskUser.RemoteHostIP).sName & " - " & m_wskUser.RemoteHostIP & " - " & strData, Outgoing
           'If m_blnZLine Then g_objFileAccess.AppendFile G_LOGPATH, Now & " --> " & "TO: " & g_colUsers.ItemByIP(m_wskUser.RemoteHostIP).sName & " - " & m_wskUser.RemoteHostIP & " - " & ZLineEsc(objZLib.CompressString(strData))
9:    End If
10:   On Error GoTo Err
  #End If

    #If FLASHCHAT Then
14:        If m_blnNullCharSeparator Then
15:            m_wskUser.SendData Replace(strData, "|", vbNullChar)
16:        Else
            Select Case True
                Case m_blnZLine
17:                    If LenB(strData) > g_objSettings.ZLINELENGHT Then
                        'seem like "$Z " is already obsolete
19:                        Set objZLib = New clsZLib
                        
21:                        m_wskUser.SendData "$Z " & ZLineEsc(objZLib.CompressString(strData)) & "|"
22:                    Else
23:                        m_wskUser.SendData strData
24:                    End If
                Case m_blnZPipe
                    'DC++ "arne" accepted Zline "ZPipe", need no escape or trailling pipe.
26:                    If LenB(strData) > g_objSettings.ZLINELENGHT Then
27:                        Set objZLib = New clsZLib
28:                        m_wskUser.SendData "$ZOn|" & objZLib.CompressString(strData)
29:                    Else
30:                        m_wskUser.SendData strData
31:                    End If
                Case Else
32:                    m_wskUser.SendData strData
33:            End Select
34:        End If
    #Else
        Select Case True
            Case m_blnZLine
36:                If LenB(strData) > g_objSettings.ZLINELENGHT Then
37:                    Set objZLib = New clsZLib
38:                    m_wskUser.SendData "$Z " & ZLineEsc(objZLib.CompressString(strData)) & "|"
39:                Else
40:                    m_wskUser.SendData strData
41:                End If
            Case m_blnZPipe
                'DC++ "arne" accepted Zline "ZPipe", need no escape or trailling pipe.
43:                If LenB(strData) > g_objSettings.ZLINELENGHT Then
44:                    Set objZLib = New clsZLib
45:                    m_wskUser.SendData "$ZOn|" & objZLib.CompressString(strData)
46:                Else
47:                    m_wskUser.SendData strData
48:                End If
            Case Else
49:                m_wskUser.SendData strData
50:        End Select
    #End If

53:    Set objZLib = Nothing

55:    Exit Sub

57:
Err:
'#If SVN Then
'    HandleError Err.Number, Err.Description, Erl & "|" & "clsUser_SendData() " & strData & "|" & m_strName
'#End If
61:    If ObjPtr(m_wskUser) Then frmHub.CloseSocket m_intIndex
End Sub

'Send a main chat message
Public Sub SendChat(ByRef strFrom As String, ByRef strMessage As String)
1:    On Error GoTo Err

     #If FLASHCHAT Then
4:        SendData "<" & strFrom & "> " & g_objFunctions.NMDCEscape(strMessage) & "|"
     #Else
6:       m_wskUser.SendData "<" & strFrom & "> " & g_objFunctions.NMDCEscape(strMessage) & "|"
     #End If
   
9:   Exit Sub
    
11:
Err:
12:   If ObjPtr(m_wskUser) Then frmHub.CloseSocket m_intIndex
End Sub
Public Sub SendChatLng(ByRef strFrom As String, ByRef sLngName As String)
1:    On Error GoTo Err
2:    SendChat strFrom, GetCoreMsgStr(sLngName)
3:    Exit Sub
4:
Err:
5:    HandleError Err.Number, Err.Description, Erl & "|" & "clsUser_SendChatLng(" & strFrom & ", " & sLngName & ")"
End Sub

'Send a private message
Public Sub SendPrivate(ByRef strFrom As String, ByRef strMessage As String, Optional ByRef strOtherFrom As String)
1:    On Error GoTo Err

3:    If LenB(strOtherFrom) Then
            #If FLASHCHAT Then
5:              SendData "$To: " & m_strName & " From: " & strFrom & " $<" & strOtherFrom & "> " & g_objFunctions.NMDCEscape(strMessage) & "|"
            #Else
7:             m_wskUser.SendData "$To: " & m_strName & " From: " & strFrom & " $<" & strOtherFrom & "> " & g_objFunctions.NMDCEscape(strMessage) & "|"
            #End If
9:     Else
            #If FLASHCHAT Then
11:             SendData "$To: " & m_strName & " From: " & strFrom & " $<" & strFrom & "> " & g_objFunctions.NMDCEscape(strMessage) & "|"
            #Else
13:             m_wskUser.SendData "$To: " & m_strName & " From: " & strFrom & " $<" & strFrom & "> " & g_objFunctions.NMDCEscape(strMessage) & "|"
            #End If
15:    End If
    
17:    Exit Sub
    
19:
Err:
20:    If ObjPtr(m_wskUser) Then frmHub.CloseSocket m_intIndex
End Sub
Public Sub SendPrivateLng(ByRef strFrom As String, ByRef sLngName As String, Optional ByRef strOtherFrom As String)
1:    On Error GoTo Err
2:    SendPrivate strFrom, GetCoreMsgStr(sLngName), strOtherFrom
3:    Exit Sub
4:
Err:
5:    HandleError Err.Number, Err.Description, Erl & "|" & "clsUser_SendPrivateLng(" & strFrom & ", " & sLngName & ", " & strOtherFrom & ")"
End Sub
'Redirect to strAddress - default is the default redirect address
Public Sub Redirect(Optional ByRef strAddress As String)
1:    On Error GoTo Err
    
3:    If LenB(strAddress) Then
4:        m_wskUser.SendData "$ForceMove " & strAddress & "|"
5:    Else
6:        frmHub.NextRedirect
7:        m_wskUser.SendData "$ForceMove " & g_objSettings.RedirectIP & "|"
8:    End If
 
10:   DoEvents

      'Show pupop notification ..
13:   If g_objSettings.PopUpUserRedirected Then _
              g_objFunctions.ShowBallon "PT DC Hub " & vbVersion, g_objSettings.HubName & vbNewLine & "Connection Redirected" & vbNewLine & "IP: " & m_wskUser.LocalIP, 0, True

16:   AddLog vbNewLine & "Connection Redirected" & vbNewLine & _
                         "IP: " & m_wskUser.LocalIP & vbNewLine & _
                         "Address: " & strAddress
19:
Err:
    'HandleError Err.Number, Err.Description, Erl & "|" & "clsUser_Redirect() " & strAddress & "|" & g_objSettings.RedirectIP
22:    frmHub.CloseSocket m_intIndex
End Sub

'Disconnect them from the hub
Public Sub Disconnect()
1:    If ObjPtr(m_wskUser) Then frmHub.CloseSocket m_intIndex
End Sub

'Disconnect them and ban them by IP for lngMinutes
Public Sub Kick(Optional ByRef lngMinutes As Long = -1, Optional strBannedBy As String = Empty, Optional strReason As String = Empty)
1:    On Error Resume Next
3:    If Not lngMinutes = -1 Then
4:       g_colIPBans.Add m_strIP, lngMinutes, m_strName, strBannedBy, strReason
5:    Else
6:       g_colIPBans.Add m_strIP, g_objSettings.DefaultBanTime, m_strName, strBannedBy, strReason
7:    End If
8:    If g_objSettings.DescriptiveBanMsg Then
9:           Me.SendChat g_objSettings.BotName, Me.GetCoreMsgStr("KickedBecause") & " " & strReason & "|"
10:   End If
11:   frmHub.CloseSocket m_intIndex
End Sub

'Disconnect them and ban their IP permanently
Public Sub Ban(Optional strBannedBy As String = Empty, Optional strReason As String = Empty)
1:    On Error Resume Next
2:    g_colIPBans.Add m_strIP, -1, m_strName, strBannedBy, strReason
3:    If g_objSettings.DescriptiveBanMsg Then
4:         Me.SendChat g_objSettings.BotName, Me.GetCoreMsgStr("BannedBecause") & " " & strReason & "|"
5:    End If
6:    frmHub.CloseSocket m_intIndex
End Sub

Public Function GetCoreMsgStr(ByRef strStringID As String) As String
'------------------------------------------------------------------
'Purpose:   Get proper core/reason messages
'           base on string key name and user language preference.
'
'Params:    strStringID :   Key of the string in the collection (a.e. "LoggedIn")
'           objUser :   object user object
'
'Return:    Return the proper string for each registered users, default to english strings if not.
'
'------------------------------------------------------------------
  
12:    Dim colLang As Collection
  
14:    On Error Resume Next
  
16:    If IsEmpty(m_strLanguageID) Then
        'this one is sure since it is(will be) hardcoded.
18:        Set colLang = g_colLanguages("en")
19:    Else
20:        Set colLang = g_colLanguages(m_strLanguageID)
  
22:        If IsEmpty(colLang) Then
            'this one is sure since it is(will be) hardcoded.
24:            Set colLang = g_colLanguages("en")
25:        End If
26:    End If
  
28:    GetCoreMsgStr = colLang.Item(strStringID)
  
30:    Set colLang = Nothing
  
End Function

Private Function ZLineEsc(ByRef strData As String) As String
'------------------------------------------------------------------
'Purpose:   Escaping DC protocol commands ending pipe "|" when sending data to a ZLine enabled clients
'
'Params:    strString :   string that need escaping due to ZLine
'
'Return:    Return the characters escaped string
'
'------------------------------------------------------------------
9:    Dim strTmp          As String

11:    On Error GoTo Err

    'escape \, warning! a \ in a pattern must be escaped with a \
14:    strTmp = g_objRegExps.REReplace(strData, "\\", "\\")
    'escape |, warning a | in a pattern must be escaped with a \
16:    strTmp = g_objRegExps.REReplace(strTmp, "\|", "\P")

18:    ZLineEsc = strTmp

20:    Exit Function

22:
Err:
23:    HandleError Err.Number, Err.Description, Erl & "|" & "clsUser_ZLineEsc(" & strData & ")"
End Function
